00100	C  SUBRS. VLINE, ASKIT, GRED, LPEN, SAVIT, LISTP ***************
00200	
00300	
00400		SUBROUTINE VLINE(R3,R4,R5,R6)
00500		INTEGER ASK
00600		COMMON /MKX/KSLA,ISEMI,LESS,IGT/A2Z/LAA,LBB,NONO(9),LEL
00700		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /IDEV/IDEV
00800		IF(R5.NE.0)GO TO 66 
00900	267 	IF(IDEV.EQ.5)
01000		1 CALL TYPSTR('TYPE STAFF #, POS1, POS2 AND CODE #  ')
01100	CRR** NEXT WITH NEW RREAD IN MS.F4   CAN NOW TYPE M 1 0 200 16, ETC.
01200		READ(IDEV,F78F,END=167)R3,R4,R5,R6
01300	CQQ	ACCEPT F78F,R3,R4,R5,R6
01400		REREAD FA1,ASK
01500		IF(ASK.EQ.LESS)GO TO 167
01600		CALL LO2UP(ASK)
01700		IF(ASK.NE.IGT)GO TO 2
01800		IDEV=1
01900		GO TO 267
02000	2	IF(ASK.EQ.LBB)R3=99
02100	C  99 IS ALSO USED IN MOVER.F4
02200		IF(R3.GE.99)RETURN
02300		IF(ASK.NE.LEL)GO TO 66
02400	C  TYPE 'L' FOR LIGHT-PEN
02500		K=-1
02600	67	R4=RY
02700		CALL LPEN(R3,RY,RX)
02800		REREAD FA1,ASK
02900		CALL LO2UP(ASK)
03000		IF(ASK.EQ.LBB)R3=99
03100		IF(R3.GE.99)RETURN
03200		K=-K
03300		IF(K.GT.0)GO TO 67
03400		R5=RY
03500	C LIGHT PEN IS READ TWICE
03600	66	ASK=-1
03700		IF(R6.LT.100)GO TO 1
03800		R6=R6-100
03900	C  FOR 'ASK' ADD 100 TO PARAM NUMBER GIVEN.
04000		ASK=0
04100	1	CALL BOX(-1,R4)
04200		CALL BOX(-2,R5)
04300	C  PUTS UP TWO VERTICAL LINES
04400		RETURN
04500	CCC3	FORMAT(' TYPE STAFF #, POS1, POS2 AND CODE #  '$)
04600	167	IDEV=5    
04700		GO TO 267
04800		END
04900	
05000	
05100		SUBROUTINE ASKIT
05200		INTEGER ASK
05300		COMMON /DPY/ST(4000),MEDIT,IGO/A2Z/NONO(6),LGG
05400		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
05500		COMMON /XRN/RN(1) /KJY/ K,JY
05600		IGO=0
05700		CALL DPYNEW
05800		X=ST(2)
05900		CALL BOX(JY,RN(JY+2))
06000		ST(2)=X
06100	  	CALL TYPSTR('N=NO, <CR>=YES, G=GO  ')
06200		ACCEPT FA1,K
06300		IF(K.EQ.LGG)ASK=-1
06400		CALL DPYNEW
06500		IGO=1
06600		END
06700	
06800		SUBROUTINE GRED
06900		INTEGER PWDS
07000		COMMON /MKX/KSLA,ISEMI,LESS,IGT
07100		1/A2Z/LAA,LBB,NONO(9),LEL,LMM,LNN,NON(9),LXX
07200		COMMON /DPY/IST(4000),MEDIT,IGO /IDEV/IDEV
07300		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /KJY/ K,JY
07400		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
07500		COMMON R2,JA,J,J2,RJQ(6),RC,IZ,RX,KV,RY,IA,IB,C,D,JZ,A,
07600		1 NX,VY,RB,JQ(20) /XRN/RN(1) /ALF/INP(72),ML
07700		COMMON /PTR/PWDS(1) /POSI/STFF(8),JJB,POS
07800		1 /LIMIT/LIMIT,ITEM,L,I,IX
07900		1 /RINP/R(10,80),RPOS(100) /DPTR/IWDS(1)
08000	
08100		EQUIVALENCE (IST2,IST(2))
08200		RC=999
08300		RSTF=RC
08400	CC **CAN'T GET HERE ***IF(INP(1).NE.'A'.AND.INP(1).NE.'D')GO TO 1
08500	C  LEAVES ROUTINE
08600		POS=0
08700	C ABOVE FOR NEW RREAD IN MS.
08800	7	CALL VLINE(R2,Z,POS,RX)
08900	C  PUTS UP TWO VERTICAL LINES
09000		REREAD FA1,NX
09100		CALL LO2UP(NX)
09200		IF(NX.EQ.LBB)GO TO 170
09300		IF(R2.LT.99)GO TO 70
09400	170	JA=98
09500		RETURN
09600	70	IF(POS.EQ.0)POS=200
09700	C  0,0  DOES WHOLE STAFF
09800		IF(INP(1).NE.LAA)GO TO 4
09900	267	IF(IDEV.EQ.1)GO TO 467
10000		CALL TYPSTR(' TYPE P#, CHNG,  P#, CHNG,  P#, CHNG, ...')
10100		CALL TYPCRL
10200	467	READ(IDEV,F78F,END=167)V
10300	CQQ	ACCEPT F78F,V
10400		REREAD FA1,K
10500	C  TYPE 'L' FOR LIGHT PEN
10600		IF(K.EQ.LESS)GO TO 167
10700		CALL LO2UP(K)
10800		IF(K.NE.IGT)GO TO 367
10900		IDEV=1
11000		GO TO 267
11100	367	IF(V(1).EQ.99)GO TO 7
11200		IF(K.EQ.LBB)GO TO 7
11300	C TYPE 'B' OR 99 TO BACKUP
11400		IF(K.NE.LEL)GO TO 66
11500		DO 67 K=1,2
11600		V(2)=RY
11700		CALL LPEN(V(1),RY,RX)
11800		REREAD FA1,JA
11900		CALL LO2UP(JA)
12000		IF(JA.EQ.LBB)GO TO 7
12100	67	IF(V(1).GE.99)GO TO 7
12200		V(3)=RY
12300	66	JA=0
12400		IZ=0
12500	C  COUNTER
12600		GO TO 14
12700	167	IDEV=5
12800		GO TO 267
12900	4	JA=98
13000	C  FOR DELETIONS
13100	C  STF.N, -99    -- DELETES ALL BUT STAFF N.
13200		IF(Z.NE.-99)GO TO 14
13300		RSTF=R2
13400		R2=99
13500	14	NX=0
13600	C  LOOP STARTS HERE
13700		J=0
13800	140	NX=NX+1
13900	142	JY=PWDS(NX)
14000		RB=RN(JY+3)
14100		IF(RTLINE(JY))GO TO 6
14200		IF(RB.LT.Z)GO TO 6
14300		IF(RB.GT.POS)GO TO 6
14400		IF(RN(JY+2).EQ.RSTF)GO TO 6
14500	C  FOR -99 DELETES.
14600		RB=RN(JY+1)
14700		IF(V(1).EQ.12)GO TO 77
14800		IF(V(1).EQ.100)GO TO 341
14900	C USE P100 AND ANY CODE# TO CREATE CUES. I.E. MINI NOTES, RESTS, BEAMS.
15000		IF(RC.EQ.999)GO TO 143
15100	C  USE P12 TO INVERT STEM, BEAM AND SLURS ALL AT ONCE.
15200	C  SET 12 TO 1 WITH CODE 5 TO INVERT SLURS ONLY
15300	77	RC=0
15400		IF(RB.EQ.5)GO TO 141
15500		IF(RB.NE.6)GO TO 143
15600		IF(RX.EQ.1)GO TO 141
15700	143	IF(RB.NE.RX.AND.RX.NE.0)GO TO 6
15800		IF(ASK)GO TO 100
15900		CALL ASKIT
16000		IF(K.EQ.LNN)GO TO 6
16100		IF(K.EQ.LXX)GO TO 19
16200	100	IF(INP(1).EQ.LAA)GO TO 141
16300		IF(J)GO TO 40
16400		J=-1
16500		K=NX
16600	41	IZ=NX
16700		IF(NX.LT.ITEM)GO TO 140
16800	40	IF(NX-IZ.EQ.1)GO TO 41
16900	C  GO BACK FOR MORE - IF IN RIGHT ORDER.
17000	C  RANGE TO DEL. = K→NX
17100	45	J=IZ+1
17200		IA=PWDS(K)
17300		IB=PWDS(J)-IA
17400		JZ=IWDS(K)
17500		J2=IWDS(J)-JZ
17600		J=J-K
17700		ITEM=ITEM-J
17800		DO 42 IZ=K,ITEM+1
17900		PWDS(IZ)=PWDS(IZ+J)-IB
18000	42	IWDS(IZ)=IWDS(IZ+J)-J2
18100		IST2=IST2-J2
18200		I=I-IB
18300		 CALL LOOP(IA,I,1,0,IB,RN)
18400		CALL LOOP(JZ+2,IST2+2,1,0,J2,IST)
18500		IF(K.GE.ITEM)GO TO 1
18600	C  EXITS
18700		NX=K+1
18800		GO TO 142
18900	341	IF(RB.EQ.6)GO TO 141
19000		IF(RB.GT.2)GO TO 6
19100	141	IF(IZ.GE.97)GO TO 9
19200	C   THERE'S A LIMIT TO THE R ARRAY    4/18/73
19300		IZ=IZ+1
19400	C  FOUND AN ITEM
19500		R(1,IZ)=223
19600	C 223 IS CODE NUMB. FOR EDIT MODE 
19700		R(2,IZ)=NX
19800	10	IZ=IZ+1
19900		DO 101 KV=3,10
20000	101	R(KV,IZ)=0
20100		IF(V(1).NE.100)GO TO 131
20200	231	R(1,IZ)=400
20300	C  MAKES MINI NOTES, RESTS, BEAMS
20400		R(2,IZ)=100
20500		GO TO 6
20600	131	IF(RC.EQ.999)GO TO 11
20700		IF(RB.EQ.1)GO TO 30
20800	31	RC=RN(JY+7)
20900		IF(RB.EQ.6)GO TO 32
21000	C  NEXT INVERTS DIP
21100		IF(RX.EQ.1)GO TO 35
21200		A=-1.6
21300		RB=-10
21400		IF(RC)A=-A
21500	CC***????  WHY CHANGE P2???  ****36	R(7,IZ)=2
21600	CC***	R(8,IZ)=RN(JY+2)+A
21700		GO TO 37
21800	35	RB=-4
21900		IF(RN(JY+8).LT.-1)RB=-1.4
22000	C  2 AND .7 ARE HGTS SET IN 'BEAMS'
22100	37	IF(RC)RB=-RB
22200		R(3,IZ)=4
22300		R(4,IZ)=RN(JY+4)+RB
22400		R(6,IZ)=RN(JY+5)+RB
22500		R(5,IZ)=5
22600	33	R(1,IZ)=7
22700		R(2,IZ)=-RC
22800		GO TO 6
22900	32	IF(RC.LT.20)GO TO 34
23000	C  THIS IS FOR BEAMS
23100	232	RC=10-RC
23200		GO TO 33
23300	132	IF(RC.GT.-20)GO TO 232
23400		GO TO 332
23500	34	IF(RC)GO TO 132
23600	C  P7 IS NEG FOR TREMOLOS
23700	332	RC=-10-RC
23800		GO TO 33
23900	
24000	C  NEXT INVERTS STEMS EITHER WAY. USE ANY #>11 WITH CODE 1 TO INVERT.
24100	C  MUST! BE FIRST IN LIST!!!
24200	C	RC=0
24300	30	RB=RN(JY+5)
24400		IF(RB.LT.10)GO TO 12
24500	C  NO STEM < 10
24600		RC=10
24700		IF(RB.GE.20)RC=-RC
24800		RB=RB+RC
24900	12	V(1)=5.
25000		V(2)=RB
25100	C  SO IT WILL DISPLAY RESULT
25200	11	DO 8 K=1,10
25300	8	R(K,IZ)=V(K)
25400	6	IF(J)GO TO 45
25500		IF(NX.LT.ITEM)GO TO 140
25600	19	IF(INP(1).NE.LAA)GO TO 1
25700	9	R(1,IZ+1)=222
25800		R(1,IZ+2)=0
25900	CC	REND=-1.
26000	1	CALL HYDPOG(3)
26100		END
26200	
26300		SUBROUTINE LPEN(A,B,C)
26400		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
26500		COMMON /POSI/STFF(0/7),JJ2,POS /ALF/INP(71),M,L /C/MM,LL
26600		COMMON /A2Z/LAA,LBB,NONO(21),LXX
26700		M=MM
26800		L=LL
26900		IF(IABS(M).GT.512)GO TO 4
27000		IF(IABS(L).LE.512)GO TO 3
27100	4	M=0
27200		L=100
27300	3	CALL SETCUR(M,L,0)
27400		CALL TYPSTR('TYPE <CR> TO SET POINT')
27500		ACCEPT FA1,JD
27600		IF(JD.EQ.'9')RETURN
27700		IF(JD.EQ.LXX)RETURN
27800	C  TYPE 'B' OR 99 TO BACK UP
27900		IF(JD.EQ.LBB)RETURN
28000		CALL RDCUR(M,L)
28100		L=(L+KCEN)/RSZ
28200	1	B=((M+JCEN)/RSZ+596.0)/5.96
28300	C  B=HORIZ. STEP NUM.
28400		DO 13 K=0,7
28500		M=STFF(K)+60.
28600		IF(L.GT.M)GO TO 13
28700		A=K
28800	C  A=STAFF NUM.
28900		GO TO 8
29000	13	CONTINUE
29100	8	C=IFIX((L-STFF(K)+21.)/7.+.5)
29200	C  FINDS VERT. NOTE NUM.
29300		TYPE F78F,A,B
29400		END
29500	
29600	
29700		SUBROUTINE SAVIT
29800		IMPLICIT INTEGER(A-Q,S-Z)
29900		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/DL/X22,SAVER,NAME,EXT
30000		1 /POSI/STFF(0/7),JJ2,IPOS /LIMIT/LIMIT,ITEM,L,I,IX 
30100		1 /SCM/V(78),ISCR,LCNT,IRSTF,LIST(200),REND  /IDEV/IDEV
30200		1 /ALF/INP(72),ML/XRN/RN(1)/DPY/ST(4000),MEDIT,IGO
30300		1 /STF/RSTFAC(0/7),RSTJ2 /PTR/PWDS(1) /JCHAR/IXX,ISEMI,IBLA
30400		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
30500		COMMON /A2Z/LAA,LBB,LCC,LDD,NONO(8),LMM,LNN,NON(4),LSS
30600		DIMENSION SV(128)
30700		EQUIVALENCE (INP2,INP(2)),(ST2,ST(2)),(SV,LIST)
30800	C  'SAME' WILL REPEAT CURRENT NAME.  BLANK WILL USE TMP.MS
30900		KX=-1
31000		K=0
31100	32	K=K+1
31200	C  THIS IS TO REPAIR DAMAGE DONE BY UNKNOWN BUGS!!!!
31300	33	L=PWDS(K)
31400		IA=PWDS(K+1)
31500		IB=RN(L)+3.+L
31600	C  THIS SHOULD BE NEW POINTER
31700		IF(IA-IB.EQ.0)GO TO 36
31800		IF(RN(IB)+3+IB.NE.PWDS(K+2))GO TO 38
31900		J=K+1
32000		PWDS(J)=IB
32100		CALL TYPSTR('?FIXED UP ITEM ')
32200		CALL TYPINT(J)
32300		CALL TYPCRL
32400		GO TO 36
32500	38	IJ=IA-L
32600		DO 39 J2=K+1,ITEM
32700	39	PWDS(J2)=PWDS(J2+1)-IJ
32800		CALL TYPSTR('BAD ITEM--')
32900		CALL TYPINT(K)
33000		CALL TYPCRL
33100		IF(KX.EQ.0)GO TO 50
33200		CALL TYPSTR('NAME.EXT? ')
33300		ACCEPT 141,INP
33400		CALL NAMEXT(INP,NAME,EXT)
33500	C  ONLY DOES THIS ON THE FIRST ERROR
33600		GO TO 2
33700	50	J=RJ
33800		KX=0
33900		CALL LOOP(L,I,1,0,J,RN)
34000	C  REARRANGES DATA
34100		I=I-J
34200		ITEM=ITEM-1
34300		IF(ITEM.LE.K)GO TO 37
34400		GO TO 33
34500	C  GO BACK AND TRY AGAIN
34600	36	IF(IA.LE.L)GO TO 38
34700	C  JUMP IF PWDS IS OUT OF ORDER
34800		IF(K.LT.ITEM)GO TO 32
34900	37	KX=-1
35000		IF(SAVER.GE.0)GO TO 10
35100		SAVER=5
35200	101	CALL PUTEXT('TMP','MS ')
35300		GO TO 102
35400	1	FORMAT(I,24F)
35500	2	CALL TYPCHR('WRITE OVER   ',13)
35600		CALL TYPWRD(NAME)
35700		CALL TYPCHR('.',1)
35800		CALL TYPCHR(EXT,3)
35900		CALL TYPCHR('?  ',3)
36000		ACCEPT 141,INP
36100		CALL LULOOP
36200		IF(INP(1).NE.LNN)GO TO 4
36300	10	IF(INP2.EQ.LMM)GO TO 4
36400	11	L=NAME
36500		INP(1)=-1
36600		CALL NAMEXT(INP,NAME,EXT)
36700		IF(NAME.NE.IBLA)GO TO 40
36800		CALL TYPSTR('NAME.EXT? ')
36900		ACCEPT 141,INP   
37000		CALL NAMEXT(INP,NAME,EXT)
37100		IF(NAME.EQ.IBLA)GO TO 4
37200	C 99 WILL BACK UP.
37300		IF(NAME.NE.'99')GO TO 40
37400		NAME=L
37500		RETURN
37600	40	IF(NAME.NE.'SAME')GO TO 43
37700		NAME=L
37800		GO TO 4
37900	141	FORMAT(72A1)
38000	43	IF(LOOKX(NAME,EXT))GO TO 2
38100	C  JUMP BACK IF FILE NAME ALREADY ON DSK
38150		IF(IDEV.NE.1)GO TO 4
38170		CALL TYPWRD(NAME)
38180		CALL TYPCHR('.',1)
38190		CALL TYPCHR(EXT,3)
38195		CALL TYPCRL
38200	4	IF(KX.EQ.0)GO TO 50
38300		IF(NAME.NE.IBLA)GO TO 41
38400		NAME=L
38500		GO TO 101
38600	41	CALL PUTEXT(NAME,EXT)
38700	42	IF(INP2.EQ.LDD)GO TO 202
38800	C   SB=SAVE BIG;  SD=SAVE DPY ONLY; SM=SB WITH SAME NAME
38900	102	IRSTF=0
39000		IF(INP2.EQ.LBB)IRSTF=-1
39100		JJ2=ITEM+2
39200		IPOS=I
39300	C WD CNTS
39400		CALL EXTOUT(RSTFAC,128)
39500	C  INCLUDES STFF AND V ARRAYS
39600	C***	CALL EXTOUT(PWDS,JJ2)
39700		CALL EXTOUT(RN,IPOS)
39800		IF(LCNT.GT.1)CALL EXTOUT(LIST,LCNT)
39900	CC102	WRITE(21)ITEM,I
40000	CC	1,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,(V(L),L=1,ISCR),
40100	CC	1 LCNT,(LIST(L),L=1,LCNT),RSTFAC,STFF,SV
40200	C (SV) FOR FORTRAN READ BUG!!!!
40300	CC	IF(SAVER.GE.0)WRITE(21)RSTFAC,STFF,L
40400	C NOT USED WHEN SAVE IS AUTOMATIC.
40500	C  TAKE OUT ABOVE WHEN BUG IS SOMEDAY FIXED IN F4.
40600		IF(I.LE.LIMIT)GO TO 20
40700		CALL TYPSTR('****** TOO MUCH DATA TO PRINT - ')
40800		CALL TYPINT(I)
40900		CALL TYPCHR('/',1)
41000		CALL TYPINT(LIMIT)
41100	20	IF(INP2.EQ.LBB)CALL EXTOUT(ST,4302)
41200	1001	CALL FINEXT
41300		IF(INP(1).NE.LSS)RETURN
41400		IF(NAME.NE.IBLA)RETURN
41500		CALL TYPSTR('DISPLAY SAVED IN "TMP.MS"')
41600		CALL TYPCRL
41700	C   GO BACK IF THE SAVER WROTE THE FILE
41800		RETURN
41900	202	WRITE(21),ST2,(ST(L),L=1,ST2+2)
42000	 	GO TO 1001
42100	C   WRITES DPY BUFFER ONLY.
42200		END
42300	
42400		SUBROUTINE LISTP(LST)
42500		IMPLICIT INTEGER(A-Q,S-Z)
42600		DIMENSION LST(1)
42700		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND/ALF/I1,I2,I3
42800		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),K,JY,X,Y /XRN/RN(1)
42900		1 /STF/RSTFAC(0/7),RSTJ2 /LIMIT/LIMIT,ITEM,L,I,IX /PTR/PWDS(1)
43000		EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(RJC,RJQ(1)),(RJD,RJQ(2))
43100		1 ,(RJE,RJQ(3))
43200	
43600		JY=5
43700		IF(RJE.NE.0)JY=3
43800	CC	JD=RJD
43900	C  NO LPT FOR NOW    CC	IF(JD.NE.0)JY=3
44000	CC	DO 6334 L=IFIX(R2),JC
44100		JD=RJD
44200		IF(RJC.NE.0)GO TO 1
44300		RJC=1.
44400		JD=ITEM
44500	1	DO 6334 L=IFIX(RJC),JD
44600		X=PWDS(L)
44700		Y=RN(X)+2+X
44800		X=X+1
44900		K=RN(X)
44910		IF(I3.NE.'X')GO TO 2
44920	C TYPE 'PRX' TO CREATE 'READ' FILE WITH ALL PARAMS.
44930		WRITE(22,3)(RN(K),K=X,Y)
44940		GO TO 6334
44950	3	FORMAT(F4.0,F3.0,3F9.3,4F13.3,3F9.3)
44960	C* NOTICE -- WRITES LINES WHICH ARE TOO LONG! - THEY MUST BE EDITED.
44970	2	WRITE(JY,6333),L,LST(K),(RN(K),K=X,Y)
45000	6334	CONTINUE
45100	C  P, N1, N2, N3  TYPES ITEM LIST. N1=1ST, N2=LAST, N3=TO LPT?
45200	C  LEAVE THIS HERE SO WRITE(JY, OF R IS POSSIBLE IN DDT
45300	6333	FORMAT(I4,') ',A5,2F4.0,F8.3,F8.2,7F10.2)
45305		IF(I3.NE.'X')RETURN
45310		END FILE 22
45320	C WRITES 'FOR22.DAT'
45340		CALL TYPSTR('PARAMS WRITTEN ON FOR22.DAT')
45360		CALL TYPCRL
45400		END